home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / online / motor.EXE / MOMX.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-05  |  3KB  |  104 lines
  1. begin
  2. write('ѥ');
  3. end.
  4. ,D4,D5 :FILE;
  5.    f1,f2,f3,f4,F5,f6 :text;
  6.    str2,str1   :string[11];
  7.    STR3,STR4   :STRING[10];
  8.    STR5        :STRING[4];
  9.    STR6        :STRING[6];
  10.    ST1         :STRING[80];
  11.    x1,x2,x3,x4,x5,S,i :longint;
  12.    y1,y2,y3,y4 :real;
  13.    label 10,20,30;
  14.  
  15.                begin
  16.                i:=0;
  17.               20:i:=i+1;
  18.                if (paramstr(i) = '') then goto 30;
  19.                ASSIGN(F4,'DAT');REWRITE(F4);
  20.                ASSIGN(F2,'SAT');
  21.                assign(f3,'t');rewrite(f3);
  22.                writeln(f3,paramstr(i));reset(f3);
  23.                readln(f3,s);close(f3);
  24.                assign(f1,'mom2.dat');
  25.                reset(F1);rewrite(f2);
  26.                writeln(f2,'  0');
  27.                writeln(f2,'SECTION');
  28.                WRITELN(F2,'  2');
  29.                WRITELN(F2,'ENTITIES');
  30.                WRITELN(F2,'  0');
  31.                writeln(f2,'POLYLINE');
  32.                WRITELN(F2,'  8');
  33.                WRITELN(F2,'0');
  34.                WRITELN(F2,' 66');
  35.                WRITELN(F2,'     1');
  36.                WRITELN(F2,'  0');
  37.                10:READLN(F1,X3,X4,X5);
  38.                IF NOT (X3 = S) THEN GOTO 10;
  39.                RESET(F1);
  40.                while not eof(f1) do
  41.                begin;
  42.                readln(f1,X3,x1,x2,y1,Y2);
  43.                IF (X2 = X5) THEN
  44.                BEGIN;
  45.                writeln(f2,'VERTEX');
  46.                WRITELN(F2,'  8');
  47.                WRITELN(F2,'0');
  48.                WRITELN(F2,' 10');
  49.                WRITELN(F2,X1);
  50.                WRITELN(F2,' 20');
  51.                WRITELN(F2,X2-(y1*100)/4);
  52.                WRITELN(F2,'  0');
  53.                writeln(f4,'TEXT');
  54.                WRITELN(F4,'  8');
  55.                WRITELN(F4,'0');
  56.                WRITELN(F4,' 10');
  57.                WRITELN(F4,X1);
  58.                WRITELN(F4,' 20');
  59.                WRITELN(F4,X2);
  60.                WRITELN(F4,' 40');
  61.                WRITELN(F4,'10');
  62.                WRITELN(F4,'  1');
  63.                WRITELN(F4,ROUND(Y1*100));
  64.                WRITELN(F4,'  0');
  65.                END;
  66.                end;
  67.                assign(f6,'momX.mnu');append(f6);
  68.                writeln(f6,'[',paramstr(i),']^c(command "dxfin" "',paramstr(i),'")');
  69.                close(f6);
  70.                WRITELN(F2,'SEQEND');
  71.                WRITELN(F2,'  8');
  72.                WRITELN(F2,'0');
  73.                WRITELN(F2,'  0');
  74.                ASSIGN(F5,PARAMSTR(i)+'.DXF');
  75.                REWRITE(F5);RESET(F2);RESET(F4);
  76.                WHILE NOT EOF(F2) DO
  77.                BEGIN;
  78.                READLN(F2,ST1);WRITELN(F5,ST1);
  79.                END;
  80.                WHILE NOT EOF(F4) DO
  81.                BEGIN;
  82.                READLN(F4,ST1);WRITELN(F5,ST1);
  83.                END;
  84.                WRITELN(F5,'ENDSEC');
  85.                WRITELN(F5,'  0');
  86.                WRITELN(F5,'EOF');
  87.              CLOSE(F1);CLOSE(F2);CLOSE(F4);CLOSE(F5);
  88.              goto 20;
  89.           30:ASSIGN(D1,'SAT');ASSIGN(D2,'DAT');ASSIGN(D3,'T');
  90.              ERASE(D1);ERASE(D2);ERASE(D3);
  91.            end.
  92.  
  93.  
  94. uses crt;
  95. var
  96.    D1,D2,D3,D4,D5 :FILE;
  97.    f1,f2,f3,f4,F5,f6 :text;
  98.    str2,str1   :string[11];
  99.    STR3,STR4   :STRING[10];
  100.    STR5        :STRING[4];
  101.    STR6        :STRING[6];
  102.    ST1         :STRING[80];
  103.    x1,x2,x3,x4,x5,S,i :longint;
  104.    y1,y2,